home *** CD-ROM | disk | FTP | other *** search
/ Info-Mac 3 / Info_Mac_1994-01.iso / Development / Source / IRC client Source / ircle sources / ircle.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-05  |  3.2 KB  |  129 lines  |  [TEXT/PJMM]
  1. {    ircle - Internet Relay Chat client    }
  2. {    File: ircle    }
  3. {    Copyright © 1992 Olaf Titz (s_titz@ira.uka.de)    }
  4.  
  5. {    This program is free software; you can redistribute it and/or modify    }
  6. {    it under the terms of the GNU General Public License as published by    }
  7. {    the Free Software Foundation; either version 2 of the License, or    }
  8. {    (at your option) any later version.    }
  9.  
  10. {    This program is distributed in the hope that it will be useful,    }
  11. {    but WITHOUT ANY WARRANTY; without even the implied warranty of    }
  12. {    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    }
  13. {    GNU General Public License for more details.    }
  14.  
  15. {    You should have received a copy of the GNU General Public License    }
  16. {    along with this program; if not, write to the Free Software    }
  17. {    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.    }
  18.  
  19. program ircle;
  20. { This is a small IRC client for the Macintosh. }
  21. { Written by Olaf Titz (s_titz@ira.uka.de), Karlsruhe, July/August 1992. }
  22. { The TCP interface code written  by Peter N.Lewis and Harry Chesley/Apple Computer Inc. }
  23. { Parts of the command protocol handling, and many ideas }
  24. {   derived from IRCII by Michael Sandrof }
  25.  
  26. uses
  27.     TCPTypes, TCPStuff, TCPConnections,{}
  28.     Coroutines, ApplBase, MsgWindows, InputLine, {}
  29.     IRCGlobals, IRCaux, IRCPreferences, IRCInput, {}
  30.     IRCCommands, IRCChannels, IRCNotify, IRCSComm, IRCHelp, IRCInit;
  31.  
  32. const
  33.     NOTIFY_INTERVAL = 30; { Seconds between notify checks }
  34.  
  35. var
  36.     i, notify: integer;
  37.     fmem, lofmem, t0: longint;
  38.     purged: boolean;
  39.     FMenu: MenuHandle;
  40.  
  41. {$SETC autoopen=false}
  42.  
  43. {$IFC DISTRIBUTION }
  44. {$SETC autoopen=true }
  45. {$ENDC}
  46.  
  47. { CheckMem gets called once in each run through the main event loop. }
  48. { If free memory runs low, first memory is compacted, then an alert is displayed }
  49. { and subsequent memory checking disabled for 30 seconds, or until more memory gets freed, }
  50. { e.g. by closing a window. }
  51. procedure CheckMem;
  52.     var
  53.         i: longint;
  54.     begin
  55.         if fmem < 0 then begin
  56.             getdatetime(i);
  57.             if (abs(i - lofmem) > MEMTIME) or (freemem > HIFREEMEM) then
  58.                 fmem := LOFREEMEM;
  59.         end
  60.         else if freemem < fmem then begin
  61.             if purged then begin
  62.                 fmem := -1;
  63.                 getdatetime(lofmem);
  64.                 if not MWFreeMem then
  65.                     i := Alert(A_LOWMEM, nil)
  66.             end
  67.             else begin
  68.                 PurgeMem(maxSize);
  69.                 purged := true
  70.             end
  71.         end
  72.         else
  73.             purged := false;
  74.     end;
  75.  
  76. function Clock (var e: EventRecord): boolean;
  77.     begin
  78.         CheckMem;
  79. {    if GetWRefCon(FrontWindow) = 0 then}
  80. {    DisableItem(FMenu, M_F_CLOSE)}
  81. {    else}
  82. {    EnableItem(FMenu, M_F_CLOSE);}
  83.         if abs(e.when - t0) >= 60 then begin
  84.             t0 := e.when;
  85.             UpdateStatusLine;
  86.             notify := notify + 1;
  87.             if notify >= NOTIFY_INTERVAL then begin
  88.                 notify := 0;
  89.                 if not IsAway then
  90.                     RunNotify
  91.             end
  92.         end;
  93.         Clock := false
  94.     end;
  95.  
  96.  
  97. procedure ExitTCP;
  98.     var
  99.         i: integer;
  100.     begin
  101.         if logging then
  102.             close(logfile);
  103.         FinishEverything
  104.     end;
  105.  
  106. begin
  107.     serverStatus := -1;
  108.     fmem := LOFREEMEM;
  109.     purged := false;
  110.     if IRCInitAll then begin
  111.         notify := 0;
  112.         i := ApplTask(@Clock, nullEvent);
  113.         ApplExitproc(@ExitTCP);
  114.         UnloadSeg(@IRCInitAll);
  115.         t0 := -maxlongint;
  116.         FMenu := GetMHandle(fileMenu);
  117. {$IFC autoopen}
  118.         if validPrefs then begin
  119.             OpenConnection;
  120.             if serverStatus = S_CONN then
  121.                 RegUser
  122.         end;
  123. {$ENDC}
  124.         repeat
  125.             ApplRun;
  126.         until QuitRequest;
  127.         ApplExit;
  128.     end;
  129. end.